home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
051-060
/
amok52
/
abitur
/
txt
/
abiturscreen.mod
< prev
next >
Wrap
Text File
|
1993-11-04
|
6KB
|
247 lines
IMPLEMENTATION MODULE AbiturScreen;
FROM Intuition IMPORT NewScreen, OpenScreen, CloseScreen,
NewWindow, OpenWindow, CloseWindow,
ViewPortAddress, WindowPtr,
IDCMPFlags, IDCMPFlagSet,
WindowFlagSet, WindowFlags,
ScreenFlagSet, ScreenFlags, customScreen,
IntuiMessage, IntuiMessagePtr;
FROM Arts IMPORT TermProcedure, Assert, BreakPoint;
FROM SYSTEM IMPORT ADR, ADDRESS;
FROM Exec IMPORT WaitPort, GetMsg, ReplyMsg;
FROM Graphics IMPORT SetRGB4, SetAPen, Move, ClearScreen, RectFill,
RastPortPtr, ViewModeSet, Text;
FROM Str IMPORT Length, Copy;
PROCEDURE CloseAtEnd;
BEGIN
(* BreakPoint(ADR("AbiScr. CloseAtEnd")); *)
IF BACKWindow # NIL THEN
CloseWindow(BACKWindow);
BACKWindow := NIL
END;
IF BACKScreen # NIL THEN
CloseScreen(BACKScreen);
BACKScreen := NIL
END
END CloseAtEnd;
PROCEDURE OpenTextWindow(Breite, Hoehe: INTEGER): WindowPtr;
VAR TmpNewWindow: NewWindow;
TmpWPtr: WindowPtr;
(* Öffne ein Fenster zum Beispiel zur TextAusgabe,
* Zur Ausgabe von Informationen über einen Spieler,
* Zur Ausgabe von Help-Files, Spielregeln etc.
*)
BEGIN (* OpenTextWindow *)
WITH TmpNewWindow DO
leftEdge := 10;
topEdge := 12;
width := Breite;
height := Hoehe;
detailPen := 0;
blockPen := 1;
idcmpFlags := IDCMPFlagSet{closeWindow, mouseButtons, vanillaKey,
inactiveWindow};
flags := WindowFlagSet{windowDrag, windowClose,
activate, noCareRefresh};
firstGadget := NIL;
checkMark := NIL;
title := NIL;
screen := BACKScreen;
bitMap := NIL;
minWidth := 0; maxWidth := 320;
minHeight := 0; maxHeight := 256;
type := customScreen
END;
TmpWPtr := OpenWindow(TmpNewWindow);
Assert(TmpWPtr#NIL, ADR("Window Problem"));
SetAPen(TmpWPtr^.rPort, 1);
RETURN TmpWPtr
END OpenTextWindow;
PROCEDURE WaitCloseGadget(W: WindowPtr);
VAR im: IntuiMessagePtr;
BEGIN
IF W # NIL THEN
WaitPort(W^.userPort);
im := GetMsg(W^.userPort);
ReplyMsg(im);
CloseWindow(W)
END (* WHIlE *)
END WaitCloseGadget;
TYPE NormalString = ARRAY[0..50] OF CHAR;
VAR AbiText: ARRAY[0..30] OF NormalString;
NextLine: INTEGER;
PROCEDURE ClearAbiTxt;
VAR i : INTEGER;
BEGIN
FOR i := 0 TO 30 DO
AbiText[i][0] := 0C
END;
NextLine := 0;
END ClearAbiTxt;
PROCEDURE AddAbiTxtLin(Str: ARRAY OF CHAR);
(* Fügt eine Textzeile an, die mit ShowAbiTxt gezeigt werden kann. *)
BEGIN
Copy(AbiText[NextLine], Str);
INC(NextLine)
END AddAbiTxtLin;
PROCEDURE ShowAbiTxt(Col: INTEGER);
(* Zeichnet alle Zeilen, die mit AddAbiTxtLin angefügt wurden.*)
VAR W: WindowPtr;
l, Longest: INTEGER;
i: INTEGER;
BEGIN
IF NextLine = 0 THEN RETURN END;
Longest := 0;
FOR i := 0 TO NextLine - 1 DO
l := Length(AbiText[i]);
IF l > Longest THEN
Longest := l
END
END;
W := OpenTextWindow(Longest * 8 + 12, NextLine * 11 + 13);
SetAPen(W^.rPort, Col);
FOR i := 0 TO NextLine - 1 DO
Move(W^.rPort, 6, i * 11 + 19);
Text(W^.rPort, ADR(AbiText[i]), Length(AbiText[i]))
END;
WaitCloseGadget(W);
ClearAbiTxt
END ShowAbiTxt;
VAR RP: RastPortPtr; (* Der RPort des BACKWindows *)
PROCEDURE TafelPutz;
BEGIN
SetAPen (RP, weisS);
RectFill(RP, 3, 15, 317, 116);
SetAPen (RP, schwarZ);
RectFill(RP, 4, 16, 316, 115);
SetAPen (RP, dgraU);
RectFill(RP, 159, 15, 160, 116);
(* Kreiden Fach *)
SetAPen (RP, schwarZ);
RectFill(RP, 289, 116, 312, 126);
SetAPen (RP, dgraU);
RectFill(RP, 290, 117, 311, 125);
SetAPen (RP, roT);
RectFill(RP, 292, 115, 293, 116);
SetAPen (RP, blaU);
RectFill(RP, 295, 116, 296, 117);
SetAPen (RP, gelB);
RectFill(RP, 300, 114, 301, 115);
END TafelPutz;
(*** HauptProgramm **)
VAR MyNewScreen: NewScreen;
VAR MyNewWindow: NewWindow;
BEGIN
BACKScreen := NIL;
BACKWindow := NIL;
TermProcedure(CloseAtEnd);
ClearAbiTxt;
WITH MyNewScreen DO
leftEdge := 0;
topEdge := 0;
width := 320;
height := 256; (* Eventuell Maximal mögliche ScreenHoehe *)
depth := 3;
detailPen := 0;
blockPen := 1;
viewModes := ViewModeSet{}; (* Normal kein HAM, extrahalfb. etc. *)
type := customScreen; (* sollte gut sein ??? *)
font := NIL;
defaultTitle := ADR(" S c h u l s t r e ß ");
gadgets := NIL;
customBitMap := NIL
END;
BACKScreen := OpenScreen(MyNewScreen);
Assert(BACKScreen#NIL, ADR("Screen Problem"));
WITH MyNewWindow DO
leftEdge := 0;
topEdge := 0;
width := 320;
height := 256; (* Eventuell Maximal mögliche WindowHoehe *)
detailPen := 0;
blockPen := 1;
idcmpFlags := IDCMPFlagSet{menuPick, gadgetUp};
flags := WindowFlagSet{backDrop, borderless, noCareRefresh, activate};
firstGadget := NIL;
checkMark := NIL;
title := NIL (* ADR("") *); (* Geht, da ("") hier global ist. *)
screen := BACKScreen;
bitMap := NIL;
minWidth := 320; maxWidth := 320;
minHeight := 256; maxHeight := 256;
type := customScreen
END;
BACKWindow := OpenWindow(MyNewWindow);
Assert(BACKWindow#NIL, ADR("Window Problem"));
SetRGB4(ViewPortAddress(BACKWindow), schwarZ, 0, 0, 0);
SetRGB4(ViewPortAddress(BACKWindow), weisS , 15, 15, 15);
SetRGB4(ViewPortAddress(BACKWindow), hgraU , 11, 11, 11);
SetRGB4(ViewPortAddress(BACKWindow), dgraU , 8, 8, 8);
SetRGB4(ViewPortAddress(BACKWindow), roT , 15, 0, 0);
SetRGB4(ViewPortAddress(BACKWindow), grueN , 0, 15, 0);
SetRGB4(ViewPortAddress(BACKWindow), blaU , 0, 10, 15);
SetRGB4(ViewPortAddress(BACKWindow), gelB , 15, 15, 0);
RP := BACKWindow^.rPort;
(* Hintergrund grau *)
SetAPen (RP, hgraU);
RectFill(RP, 0,0,320, 256);
(* Tafel *)
TafelPutz;
END AbiturScreen.